home *** CD-ROM | disk | FTP | other *** search
/ Ultimedia 1 / Ultimedia 1.iso / tools / sonstiges / loadmpeg / deu / loadmpeg_adpro.ma next >
Text File  |  1994-07-01  |  9KB  |  370 lines
  1. /*                                                                        */
  2. /*  LoadMPEG_adpro.ma                                    Alex Kazik 1994  */
  3. /*  LoadMPEG_HAM6.ma                                                      */
  4. /*  LoadMPEG_HAM8.ma          Alle drei ARexx-Scripte sind zum laden von  */
  5. /*                    MPEG-Animationen. Das Script xxx_adpro konvertiert  */
  6. /*                     die Bilder mit hilfe von ADPro auf ein beliebiges  */
  7. /*   Format, dir Dither und Palette Option wird unterstützt. Dir Scripte  */
  8. /*      xxx_HAM* wandeln die Anim ohne ADPro in das HAM6/HAM8 format um.  */
  9. /*                                                                        */
  10. /*   Alle verwendeten Programme zur decodiering der MPEG-Anims sowie der  */
  11. /*   Konvertierung yuv2ppm und ppm2ilbm sind Public-Domain.               */
  12. /*                                                                        */
  13.  
  14. OPTIONS RESULTS
  15.  
  16. address MAINACTOR
  17. printandstoretxt "ALX:MPEG Loader  -  by Alex Kazik 1994"
  18.  
  19. RequestFile "MPEG-File auswählen"
  20. IF RC = 10 THEN 
  21.   call xEXIT 1
  22. mpgfile = RESULT
  23.  
  24. if ( exists(mpgfile) = 0 ) then
  25.   call xexit 6
  26.  
  27. RequestSaveFile "Ziel-File auswählen"
  28. IF RC = 10 THEN 
  29.   call xEXIT 1
  30. newname = RESULT
  31.  
  32. IF exists(newname) then do
  33.   printtxt "ALX:Datei existiert schon, löschen?"
  34.   RequestSaveFile "Datei löschen -> nochmal wählen!"
  35.   IF (RC = 10) | (RESULT ~= newname) then
  36.     call xexit 5
  37.   ADDRESS COMMAND 'delete' newname
  38. end
  39.  
  40. printtxt "ALX:Decodiere MPEG..."
  41. ADDRESS COMMAND 'copy' mpgfile newname || '.mpg'
  42. wbtofront
  43. ADDRESS COMMAND 'MainActor:mpeg/mpeg -d' newname '>CON:'
  44. screentofront
  45. printtxt "ALX:Lösche TEMP."
  46. ADDRESS COMMAND 'delete' newname || '.mpg'
  47. pics=0
  48. picname = newname || pics
  49. if exists(picname || ".Y") = 0 then do
  50.   call xexit 2
  51. end
  52. if exists(picname || ".U") = 0 then do
  53.   call xexit 2
  54. end
  55. if exists(picname || ".V") = 0 then do
  56.   call xexit 2
  57. end
  58. pics=1
  59. picname = newname || pics
  60. if exists(picname || ".Y") = 0 then do
  61.   call xexit 7
  62. end
  63. if exists(picname || ".U") = 0 then do
  64.   call xexit 7
  65. end
  66. if exists(picname || ".V") = 0 then do
  67.   call xexit 7
  68. end
  69. xxx = 1
  70. do while xxx = 1
  71.   pics = pics + 1
  72.   picname = newname || pics
  73.   if exists(picname || ".Y") = 0 then
  74.     xxx = 0
  75.   if exists(picname || ".U") = 0 then
  76.     xxx = 0
  77.   if exists(picname || ".V") = 0 then
  78.     xxx = 0
  79. end
  80. printandstoretxt "ALX:Konnte" pics "Bilder finden."
  81. RequestInteger 352 "Original Bildbreite des MEPGs"
  82. IF RC = 10 THEN 
  83.   call xEXIT 
  84. width=RESULT
  85. RequestInteger 240 "Original Bildhöhe des MPEGs"
  86. IF RC = 10 THEN
  87.   call xEXIT 1
  88. height=RESULT
  89.  
  90. DO i=1 to pics                           
  91.   yuvpic = i - 1
  92.   yuvname = newname || yuvpic
  93.   actualpic=newname || "." || Right("00000" || i, 5)
  94.  
  95.   printtxt "ALX:Konvertiere Bild" i || "/" || pics || ".  (YUV -> PPM)"
  96.   ADDRESS COMMAND 'MainActor:mpeg/cyuv2ppm' yuvname 'T:ppm.TEMP' '-iw' width '-ih' height
  97.   printtxt "ALX:Konvertiere Bild" i || "/" || pics || ".  (PPM -> IFF)"
  98.   ADDRESS COMMAND 'MainActor:mpeg/ppmtoilbm >' || actualpic '-24FORCE' 'T:ppm.TEMP'
  99.   printtxt "ALX:Konvertiere Bild" i || "/" || pics || ".  (lösche TEMP)"
  100.   ADDRESS COMMAND 'delete' yuvname || ".?"
  101. END
  102.  
  103. ADDRESS COMMAND 'delete t:ppm.TEMP'
  104.  
  105. IF ~SHOW('P','ADPro') THEN DO  
  106.   PrintTXT "ALX:Erwecke AdPro..."
  107.   ADDRESS COMMAND 'run >NIL: <NIL: adpro:adpro BEHIND MAXMEM=1000000'
  108.   ADDRESS COMMAND Wait 1
  109.   i = 1
  110.   j = 30
  111.   DO UNTIL (SHOW('P','ADPro')) | (i=0)
  112.     ADDRESS COMMAND Wait 1
  113.     PrintTXT "ALX:Erwecke AdPro...   (" || i || " sec)"
  114.     i = i + 1
  115.     if (i=j) then do
  116.       RequestInteger 0 "Wie lange noch warten?  (bisher " || i || 'sec | 0=Abb.)'
  117.       IF RC = 10 then
  118.         i = 0
  119.       ELSE DO
  120.         j = j + RESULT
  121.         if i = j then
  122.           i = 0
  123.       END
  124.     END
  125.   END
  126.   CloseADPro = 1
  127. END  
  128. ELSE
  129.   CloseADPro = 0
  130.  
  131. NL = '0A'X
  132. ADDRESS "ADPro"
  133. ADPRO_TO_FRONT
  134. TempDefaults = "T:TempADProDefaults"
  135. SAVE_DEFAULTS TempDefaults
  136. PSTATUS
  137. oldPSTATUS = ADPRO_RESULT
  138. LOAD_TYPE REPLACE
  139. oldLoadType = ADPRO_RESULT
  140. ORIENTATION PORTRAIT
  141. oldLoadOrient = ADPRO_RESULT
  142. LFORMAT "IFF"
  143. oldLoader = ADPRO_RESULT
  144. IF (RC ~= 0) THEN DO
  145.   ADPRO_TO_FRONT
  146.   call xexit 3
  147. END
  148. SFORMAT "ANIM"
  149. oldSaver = ADPRO_RESULT
  150. IF (RC ~= 0) THEN DO
  151.   ADPRO_TO_FRONT
  152.   call xexit 4
  153. END
  154.  
  155. CALL GetColors
  156. RENDER_TYPE colors
  157. CALL GetPalette
  158.  
  159. if (palette = "Load") then do
  160.   GETFILE '"Palette auswählen"' "ADPRO:Colors"
  161.   IF (RC ~= 0) then
  162.     call xexit 1
  163.   palettename = ADPRO_RESULT
  164.   PLOAD palettename
  165.   palette="Locked"
  166. end
  167. if (palette = "Locked") then do
  168.   PSTATUS locked
  169.   cpf = "CPF=NO"
  170. end
  171. else do
  172.   PSTATUS UnLocked
  173.   cpf = "CPF=YES"
  174. end
  175. CALL GetDither
  176. DITHER dithermode
  177.  
  178. ADDRESS MAINACTOR
  179. screentofront
  180. DO i=1 to pics                           
  181.   actualpic=newname || "." || Right("00000" || i, 5)
  182.  
  183.   ADDRESS MAINACTOR
  184.   printtxt "ALX:Konvertiere Bild" i || "/" || pics || ".  (ADPro)"
  185.  
  186.   ADDRESS "ADPro"    
  187.   Load actualpic
  188.   Execute    
  189.   Save newname "APPEND" "IMAGE"
  190.  
  191.   ADDRESS MAINACTOR
  192.   printtxt "ALX:Konvertiere Bild" i || "/" || pics || ".  (lösche TEMP)"
  193.   ADDRESS COMMAND 'delete' actualpic
  194. END
  195.  
  196. ADDRESS "ADPro"
  197. Save newname "QUIT" "IMAGE"
  198.  
  199. ADDRESS MAINACTOR
  200. GetSPName
  201.  
  202. if (rc = 0) then
  203.   OpenNewProject                         
  204. SetSPLoader "ANIM" "IFF-Anim5"                
  205. LoadProject newname             
  206.  
  207. CALL xEXIT 0
  208.  
  209.  
  210.  
  211. GetColors:
  212. GetXX.1  = "2"
  213. GetXX.2  = "4"
  214. GetXX.3  = "8"
  215. GetXX.4  = "16"
  216. GetXX.5  = "32"
  217. GetXX.6  = "64"
  218. GetXX.7  = "128"
  219. GetXX.8  = "256"
  220. GetXX.9  = "EHB"
  221. GetXX.10 = "HAM"
  222. GetXX.11 = "HAM8"
  223. GetXXMin = 1
  224. GetXXMax = 11
  225. GetXXDef = 8
  226. CALL GetLV farBen
  227. PARSE VAR RESULT nr '"'colors'"' .
  228. PARSE VAR colors colors .
  229. if (nr = 0) then
  230.   call xexit 1
  231. return
  232.  
  233.  
  234.  
  235. GetPalette:
  236. ARG is
  237. GetXX.1  = "Locked"
  238. GetXX.2  = "UnLocked"
  239. GetXX.3  = "Load PAL"
  240. GetXXMin = 1
  241. GetXXMax = 3
  242. GetXXDef = 2
  243. CALL GetLV "Palette"
  244. PARSE VAR RESULT nr '"'palette'"' .
  245. PARSE VAR palette palette .
  246. if (nr = 0) then
  247.   call xexit 1
  248. return
  249.  
  250.  
  251.  
  252. GetDither:
  253. ARG is
  254. GetXX.1  = "Off    (0)"
  255. GetXX.2  = "Floyd  (1)"
  256. GetXX.3  = "Burkes (2)"
  257. GetXX.4  = "Sierra (3)"
  258. GetXX.5  = "Jarvis (4)"
  259. GetXX.6  = "Stucki (5)"
  260. GetXX.7  = "Random (6)"
  261. GetXX.8  = "Lg Ord (7)"
  262. GetXX.9  = "Sm Ord (8)"
  263. GetXXMin = 1
  264. GetXXMax = 9
  265. GetXXDef = 1
  266. CALL GetLV "DITHER"
  267. PARSE VAR RESULT dithermode '"'nr'"' .
  268. if (dithermode = 0) then
  269.   call xexit 1
  270. dithermode = dithermode - 1
  271. IF (Dithermode = 6) | (Dithermode = 7) | (Dithermode = 8) THEN DO
  272.   continue = 0
  273.   ADDRESS "ADPro"
  274.   GETNUMBER '"Enter Dither Amount"' 16 1 256
  275.   DitherAmt = ADPRO_RESULT
  276.  
  277.   IF (RC ~= 0) THEN
  278.     call xexit 1
  279.   DITHER_AMOUNT ditheramt
  280. END
  281. return
  282.  
  283.  
  284.  
  285. xexit:
  286. ARG fehler
  287. if (fehler = 0) then
  288.   fehler = "Done."
  289. else if (fehler = 1) then
  290.   fehler = "Die Operation wurde Abgebrochen!"
  291. else if (fehler = 2) then
  292.   fehler = "Fehler beim Dekodieren."
  293. else if (fehler = 3) then
  294.   fehler = "Kein IFF-Loader (ADPro)."
  295. else if (fehler = 4) then
  296.   fehler = "Kein ANIM-Saver (ADPro)."
  297. else if (fehler = 5) then
  298.   fehler = "Datei existiert schon."
  299. else if (fehler = 6) then
  300.   fehler = "Datei existiert nicht."
  301. else if (fehler = 7) then
  302.   fehler = "Anim muß min. 2 Bilder enthalten."
  303. IF SHOW('P','ADPro') THEN DO  
  304.   address "ADPro"
  305.   adpro_to_front
  306.   if (fehler ~= "Done.") then
  307.     OKAY1 fehler
  308.   LFORMAT oldLoader
  309.   SFORMAT oldSaver
  310.   PSTATUS oldpstatus
  311.   LOAD_TYPE oldLoadType
  312.   ORIENTATION oldLoadOrient
  313.   IF (EXISTS( TempDefaults )) THEN DO
  314.     LOAD_DEFAULTS TempDefaults
  315.     IF (RC ~= 0) THEN DO
  316.       ADPRO_TO_FRONT
  317.       OKAY1 "Error restoring settings."
  318.       ADPRO_TO_BACK
  319.     END
  320.     ADDRESS COMMAND "Delete >NIL:" TempDefaults
  321.   END
  322.   if CloseADPro then do
  323.     OKAY2 "Soll ADPro geschloßen werden?" || NL || NL || "    OK - Na klar doch!" || NL || "CANCEL - Nein."
  324.     IF RC ~= 0 then 
  325.       ADPRO_EXIT
  326.   END
  327. end
  328.  
  329. address MAINACTOR
  330. Screentofront
  331. PrintAndStoreTxt "ALX:" || fehler
  332. exit
  333.  
  334.  
  335.  
  336. GetLV:
  337. ARG GetXXTitle
  338. GetXXReq = 0
  339. String = '"' || GetXX.GetXXDef || '"'
  340. DO LoopCounter = GetXXMin TO GetXXMax
  341.     String = String '"' || GetXX.LoopCounter || '"'
  342. END
  343. ADDRESS "ADPro"
  344. ADPRO_TO_FRONT
  345.  
  346. continue = 0
  347. DO UNTIL (continue = 1)
  348.   LISTVIEW GetXXTitle (GetXXMax-GetXXMin+1) ITEMS String
  349.   LISTVIEW_RC = RC
  350.   PARSE VAR ADPRO_RESULT '"'GetXXStr'"' scratch
  351.  
  352.   GetXXRet = GetXXMin
  353.   DO WHILE (GetXXRet <= GetXXMax) & (COMPARE( GetXXStr, GetXX.GetXXRet ) ~= 0)
  354.     GetXXRet = GetXXRet + 1
  355.   END
  356.  
  357.   IF ((LISTVIEW_RC ~= 0) & (LISTVIEW_RC ~= 1)) | (GetXXStr=" -----") THEN DO
  358.     OKAY2 "Sie müßen etwas eingeben." || NL || NL || "    OK - Nochmal" || NL || "CANCEL - Abbruch"
  359.     IF (RC = 0) THEN do
  360.       GetXXRet=0
  361.       continue=1
  362.     end
  363.   END
  364.   ELSE 
  365.     continue = 1
  366. END
  367. if (GetXXRet > GetXXMax) then
  368.   GetXXRet=0
  369. Return GetXXRet '"' || GetXXStr || '"'
  370.